home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / surfmodl / surfm203.arc / SURFSRC.ARC / SURFGRAF.PAS < prev    next >
Pascal/Delphi Source File  |  1988-01-31  |  22KB  |  779 lines
  1. {$I defines.inc}
  2. Unit SURFGRAF;
  3. {Graphics primitives for Surfmodl.  These primitives use the borland .BGI }
  4. {routines.  If you add support for a new graphics system, you must update }
  5. {the SYS_NAME, LGLSYS, MAXSYS, and perhaps OLDSYS routines.  You also must}
  6. {update the SURFBGI bgi emulation routines}
  7.  
  8. INTERFACE
  9. uses crt,
  10. {$IFDEF EXTERNAL}
  11.   SURFbgi;
  12. {$ELSE}
  13.   Graph;
  14. {$ENDIF}
  15.  
  16. {$IFDEF USE8087}
  17. type real = single;
  18. {$ENDIF}
  19. { Names of all the systems currently supported by SURFMODL: }
  20. const MAXSYS = 11;        { maximum # of systems currently supported }
  21.  
  22.  
  23. const Sys_name: array[1..MAXSYS] of string[30] = (
  24.         'IBM Color Graphics Adapter',
  25.         'IBM MCGA Graphics Adapter',
  26.         'IBM Enhanced Graphics Adapter',
  27.         'IBM EGA with 64K memory',
  28.         'IBM EGA with Mono Display',
  29.         'RESERVED',
  30.         'Hercules Nono Graphics Adapter',
  31.         'AT&T 6300 400 line mode',
  32.         'IBM VGA Graphics Adapter',
  33.         'IBM 3270',
  34. {$IFDEF VAXMATE }
  35.         'DEC Vaxmate'
  36. {$ELSE}
  37.         'RESERVED'   {<<<<<< Note, this must be present and in CAPS to work}
  38. {$ENDIF}
  39.  
  40.          );
  41.  
  42.       LGLSYS: array[1..MAXSYS] of integer = (
  43.         CGA,
  44.         MCGA,
  45.         EGA,
  46.         EGA64,
  47.         EGAMONO,
  48.         RESERVED,
  49.         HERCMONO,
  50.         ATT400,
  51.         VGA,
  52.         PC3270,
  53. {$IFDEF VAXMATE}  {Make unused systems RESERVED}
  54.         VM400
  55. {$ELSE}
  56.         RESERVED
  57. {$ENDIF}
  58.         );
  59.  
  60. {table to convert old Surfmodl 1.x system number to new}
  61. const oldsys :array[1..10] of integer = (
  62.          CGA,      { CGA      : old number 1}
  63.          EGA,      { EGA      : old number 2}
  64.          HERCMono, { HERCMono : old number 3}
  65.          detect,   { Sanyo Unsupported, try to detect}
  66.          detect,   { Heath/Zenith Z-100 Unsupported, try to detect }
  67.          CGA,      { Toolbox CGA, old number 6 }
  68.          ATT400,   { AT&T 6300 mode, old number 7 }
  69.          PC3270,   { IBM 3270, old number 8 }
  70.          EGA64,    { Old QUADEGA (640x480), closest is (640x350) }
  71.          EGA64);   { Old QUADEGA (752x410), closest is (640x350) }
  72.  
  73.  
  74. var
  75.   driveron  : boolean;   { flag for if driver is on or not }
  76.   grsys     : integer;   { Graphics system being used      }
  77.   grmode    : integer;   { Graphics mode in the system     }
  78.   dorandom  : boolean;   { flag for random interpolation   }
  79.   RandShade : real;      { Random shade pattern }
  80.   Ngraphchar: integer;   { #chars across graphics screen}
  81.                          { If 0 then no text will be
  82.                            displayed on the graphics screen }
  83.   Gxmin,  Gxmax,
  84.   Gymin, Gymax: integer; { graphics screen limits }
  85.   ncolors   : integer;   { Number of colours supported in current mode}
  86.   MONO      : boolean;   { Flag for monochrome graphics }
  87.   Viewchanged : boolean; { Flag for changed viewpoint }
  88.   Flpurpose: string[127];              { title for plot }
  89.   BGIDIR : string;
  90.  
  91. procedure gplot (x,y,color:integer);
  92. procedure exgraphic;
  93. procedure closedriver; {shuts down entire graphics system }
  94. procedure GDRAW (X1t, Y1t, X2t, Y2t, Color: integer);
  95. procedure GHDRAW  (X1, X2, Y, Color: integer);
  96. procedure SHPLOT (X, Y, Color: integer; Fmod: integer);
  97. procedure SHDRAW (X1, X2, Y, Color: integer; Fmod: integer);
  98. procedure setsys;
  99.  
  100. procedure SETGMODE;
  101. procedure stopstat;
  102. function grafstat : boolean;
  103. function checkey : boolean;
  104.  
  105.  
  106. function savescrn (filename : string) : boolean;
  107.  
  108. function readscrn (filename : string; var grsys,grmode : integer;
  109.                               var bitmap : pointer) : boolean;
  110.  
  111. IMPLEMENTATION
  112.  
  113.  
  114.  
  115.  
  116. procedure gplot (x,y,color:integer);
  117. {plot one dot in given colour, with clipping}
  118. begin
  119.   putpixel (x,y,color);
  120. end;
  121.  
  122. procedure EXGRAPHIC;
  123. { Exit graphics mode }
  124. begin
  125.   RestoreCrtMode;
  126. end;  { procedure EXGRAPHIC }
  127.  
  128. procedure closedriver;
  129. { closes down the existing graphics system }
  130. begin
  131.   if driveron then begin
  132.     setgraphmode(grmode);
  133.     closegraph;
  134.     driveron := false;
  135.   end;
  136. end;
  137.  
  138. { NOTE: This file contains several routines, which are the system-independent
  139.   graphics primitives of SURFMODL:
  140.     GDRAW       - Line drawing routine
  141.     GHDRAW      - Horizontal line drawing routine
  142.     SHPLOT      - Shaded pixel plot routine
  143.     SHDRAW      - Shaded line drawing routine
  144.     DITHPLOT    - Dithered pixel plot routine
  145.     DITHDRAW    - Dithered line drawing routine
  146.     INTRPLOT    - Interpolated pixel plot routine
  147.     INTRDRAW    - Interpolated line drawing routine
  148. }
  149.  
  150.  
  151. { System Independent Line draw }
  152. procedure GDRAW (X1t, Y1t, X2t, Y2t, Color: integer);
  153. { This routine was written by Russell Nelson, to draw a line using the
  154.   GPLOT primitive -- for systems that do not provide a line drawing
  155.   primitive. This routine does NOT clip. }
  156. var
  157.   delta_x, delta_y : integer;
  158.   inc_x, inc_y : integer;
  159.   epsilon, count : integer;
  160.   x1, y1, x2, y2: integer;
  161. begin
  162.   if (x2t < x1t) then begin
  163.     { Make sure the lines are always plotted in the same direction, for
  164.       smooth line drawing in hidden line removal. }
  165.     x1 := x2t;
  166.     y1 := y2t;
  167.     x2 := x1t;
  168.     y2 := y1t;
  169.   end else begin
  170.     x1 := x1t;
  171.     y1 := y1t;
  172.     x2 := x2t;
  173.     y2 := y2t;
  174.   end;
  175.   delta_x := abs(x2 - x1);
  176.   delta_y := abs(y2 - y1);
  177. {  if x2 > x1 then inc_x := 1 else inc_x := -1; }
  178.   inc_x := 1;
  179.   if y2 > y1 then inc_y := 1 else inc_y := -1;
  180.   if delta_x > delta_y then begin
  181.     count := delta_x + 1;
  182.     epsilon := delta_x div 2;
  183.     while count>0 do begin
  184.       GPLOT(x1, y1, Color);
  185.       epsilon := epsilon + delta_y;
  186.       if epsilon > delta_x then begin
  187.         epsilon := epsilon - delta_x;
  188.         y1 := y1 + inc_y;
  189.       end;
  190.       x1 := x1 + inc_x;
  191.       count := count - 1;
  192.     end;
  193.   end else begin
  194.     count := delta_y + 1;
  195.     epsilon := delta_y div 2;
  196.     while count>0 do begin
  197.       GPLOT(x1, y1, Color);
  198.       epsilon := epsilon + delta_x;
  199.       if epsilon > delta_y then begin
  200.         epsilon := epsilon - delta_y;
  201.         x1 := x1 + inc_x;
  202.       end;
  203.       y1 := y1 + inc_y;
  204.       count := count - 1;
  205.     end;
  206.   end;
  207. end; { procedure GDRAW }
  208.  
  209.  
  210. { GHDRAW: Horizontal line draw.}
  211. procedure GHDRAW  (X1, X2, Y, Color: integer);
  212. { Special fast version that does its own clipping}
  213. var   X: integer;
  214.       X1t, X2t: integer;
  215. begin
  216.  gdraw (x1,y,x2,y,color);
  217. end; { procedure GHDRAW }
  218.  
  219. procedure SHPLOT (X, Y, Color: integer; Fmod: integer);
  220. { system-independent shaded pixel plot command }
  221. { This routine uses the system's colors as shades of grey }
  222. begin
  223.   if (Fmod > 1) then begin
  224.     if (X mod Fmod = Y mod Fmod) then
  225.       gplot (X, Y, Color)
  226.     else
  227.       gplot (X, Y, 0);
  228.   end else if (Fmod < -1) then begin
  229.     if (X mod -Fmod = Y mod -Fmod) then
  230.       gplot (X, Y, 0)
  231.     else
  232.       gplot (X, Y, Color);
  233.   end else
  234.     gplot (X, Y, Color);
  235. end; { procedure SHPLOT }
  236.  
  237. procedure SHDRAW (X1, X2, Y, Color: integer; Fmod: integer);
  238. { system-independent shaded horizontal line drawing command }
  239. { This routine uses the system's colors as shades of grey }
  240. var X: integer;           { x coord }
  241.  
  242. begin
  243.   if (abs(Fmod) < 2) then
  244.     ghdraw (X1, X2, Y, Color)
  245.   else if (Fmod > 1) then begin
  246.     for X := X1 to X2 do
  247.       if (X mod Fmod = Y mod Fmod) then
  248.         gplot (X, Y, Color)
  249.       else
  250.         gplot (X, Y, 0);
  251.   end else begin
  252.     for X := X1 to X2 do
  253.       if (X mod -Fmod = Y mod -Fmod) then
  254.         gplot (X, Y, 0)
  255.       else
  256.         gplot (X, Y, Color);
  257.   end;
  258. end; { procedure SHDRAW }
  259.  
  260.  
  261.  
  262. procedure SETSYS;
  263. { Initialize system-dependent parameters, and check for hardware presence
  264.   if possible.  (Ncolors is set to 0 if the hardware is known to not be
  265.   present.
  266. }
  267. var
  268.   sys : integer;
  269.   message : string;
  270.   modelow,modehi : integer;
  271.   num : integer;
  272.   code : integer;
  273.  
  274. begin
  275.  
  276.   if not driveron then begin
  277.     initgraph (grsys,grmode,BGIDIR);
  278.     if graphresult < 0 then begin
  279.       grsys := detect;
  280.  
  281.       initgraph (grsys,grmode,BGIDIR);
  282.       if graphresult < 0 then begin
  283.         writeln (grapherrormsg(grsys));
  284.         writeln;
  285.         writeln ('If the .BGI files are not in the current directory');
  286.         writeln ('then you can use SET to set an environment variable');
  287.         writeln ('called BGIDIR which points to the .BGI file directory.');
  288.         writeln;
  289.         writeln ('SurfModl Halted');
  290.         halt(1);
  291.       end; {Error initializing hardware from detect}
  292.     end; { error initializing selected hardware, try detect }
  293.     restorecrtmode;
  294.     driveron := true;
  295.   end {Driver not successfully initialized yet }
  296.   else
  297.     driveron := false;
  298.  
  299.   Message := 'No error';
  300.  
  301.   {Write the menu options}
  302.   While not driveron do begin
  303.  
  304.     clrscr;
  305.     if Message = 'No error' then
  306.       writeln
  307.     else
  308.       writeln ('GRAPH ERROR: ',message,^G);
  309.  
  310.     writeln;
  311.     writeln ('Choose from the following system types:');
  312.     for Sys := 1 to MAXSYS do
  313.       if (Sys_name[lglsys[sys]] <> 'RESERVED') then
  314.         writeln (Lglsys[Sys]:3,' ',Sys_name[Lglsys[Sys]]);
  315.  
  316.     grsys := 1;
  317.     repeat
  318.       write ('System Number (',grsys,'): ');
  319.       readln (message);
  320.       if message = '' then
  321.         str (grsys,message);
  322.       val(message,num,code);
  323.     until ((code = 0) and (trunc(num) in [1..MAXSYS]) and
  324.            (SYS_NAME[lglsys[num]] <> 'RESERVED'));
  325.     grsys := trunc(num);
  326.  
  327.     {Get mode for this driver}
  328.     clrscr;
  329.  
  330.     getmoderange(grsys,modelow,modehi);
  331.     if modelow <> modehi then begin {Select the graphics mode}
  332.       writeln ('Choose from the following graphics modes:');
  333.       Case grsys of
  334.         CGA : begin
  335.           writeln (' 0: 320x200, Lightgreen Lightred, Yellow');
  336.           writeln (' 1: 320x200, LightCyan, LightMagenta, White');
  337.           writeln (' 2: 320x200, Green, Red, Brown');
  338.           writeln (' 3: 320x200, Cyan, Magenta, Lightgrey');
  339.           writeln (' 4: 640x200, one colour');
  340.         end;
  341.         MCGA: Begin
  342.           writeln (' 0: 320x200, Lightgreen Lightred, Yellow');
  343.           writeln (' 1: 320x200, LightCyan, LightMagenta, White');
  344.           writeln (' 2: 320x200, Green, Red, Brown');
  345.           writeln (' 3: 320x200, Cyan, Magenta, Lightgrey');
  346.           writeln (' 4: 640x200, one colour');
  347.           writeln (' 5: 640x480, one colour');
  348.         end;
  349.         EGA : Begin
  350.           writeln (' 0: 640x200, 16 Colour');
  351.           writeln (' 1: 640x350, 16 Colour');
  352.         end;
  353.         EGA64: Begin
  354.           writeln (' 0: 640x200, 16 Colour');
  355.           writeln (' 1: 640x350, 4 Colour');
  356.         end;
  357.         EGAMONO: Begin
  358.           writeln (' 3: 640x350, 1 Colour');
  359.         end;
  360.         HercMONO: Begin
  361.           writeln (' 0: 720x348, 1 Colour');
  362.         end;
  363.         ATT400: Begin
  364.           writeln (' 0: 320x200, Lightgreen Lightred, Yellow');
  365.           writeln (' 1: 320x200, LightCyan, LightMagenta, White');
  366.           writeln (' 2: 320x200, Green, Red, Brown');
  367.           writeln (' 3: 320x200, Cyan, Magenta, Lightgrey');
  368.           writeln (' 4: 640x200, one colour');
  369.           writeln (' 5: 640x400, one colour');
  370.         end;
  371.         VGA: Begin
  372.           writeln (' 0: 640x200, 16 Colour');
  373.           writeln (' 1: 640x350, 16 Colour');
  374.           writeln (' 2: 640x480, 16 Colour');
  375.         end;
  376.         PC3270: Begin
  377.           writeln (' 0: 720x350, 1 Colour');
  378.         end;
  379. {$IFDEF VAXMATE} {DEC VAXMATE modes}
  380.         VM400 : begin
  381.           writeln (' 0: 320x200, Lightgreen Lightred, Yellow');
  382.           writeln (' 1: 320x200, LightCyan, LightMagenta, White');
  383.           writeln (' 2: 320x200, Green, Red, Brown');
  384.           writeln (' 3: 320x200, Cyan, Magenta, Lightgrey');
  385.           writeln (' 4: 640x200, one colour');
  386.           writeln (' 5: 640x400, four colour');
  387.           writeln (' 6: 640x400, one colour');
  388.         end;
  389. {$ENDIF}
  390.       end; {case}
  391.  
  392.       grmode := modehi;
  393.       repeat
  394.         write ('Enter Graphic Mode (',grmode,'): ');
  395.         readln (message);
  396.         if message = '' then
  397.           str (grmode,message);
  398.         val(message,num,code);
  399.       until ((code = 0) and (trunc(num) in [modelow..modehi]));
  400.       grmode := trunc(num);
  401.  
  402.     end; {then}
  403.  
  404.     setgraphmode(grmode);
  405.     CLOSEGRAPH;
  406.     if graphresult = 0 then; {clear the graphresult}
  407.  
  408.     initgraph (grsys,grmode,BGIDIR);
  409.     message := grapherrormsg (graphresult);
  410.     driveron := message = 'No error';
  411.     restorecrtmode;
  412.     viewchanged := true;
  413.   end; { while }
  414.  
  415.   ngraphchar := GetMaxX div 8;
  416.   GXmin := 0;
  417.   GXMax := GetMaxX ;
  418.   Gymin := 0;
  419.   GYMax := GetMaxY;
  420.   Ncolors := GetMaxColor;
  421.  
  422.   if grsys = RESERVED then
  423.     setsys; {force display of menu}
  424. end; { procedure SETSYS }
  425.  
  426.  
  427. function CHECKEY: boolean;
  428. { Return TRUE if the 'A' key has been pressed, or FALSE otherwise }
  429. var c: char;
  430.  
  431. begin
  432.   c := ' ';
  433.   if (keypressed) then begin
  434.     c := readkey;
  435.     if (upcase (c) = 'A') then
  436.       Checkey := TRUE
  437.     else
  438.       Checkey := FALSE;
  439.   end else
  440.     Checkey := FALSE;
  441. end; { function CHECKEY }
  442.  
  443.  
  444. { GRAFSTAT and STOPSTAT control the plotting of "status dots" at the bottom
  445.   of the graphics screen.  STOPSTAT clears the line away and also
  446.   reinitializes the local (static) variables.
  447. }
  448. var Statpos: integer;   { next X-position to plot a status dot }
  449.  
  450. procedure STOPSTAT;
  451. var c: char;
  452. begin
  453.   Statpos := Gxmin+3;
  454.   gdraw (Gxmin+1, Gymax-1, Gxmax-1, Gymax-1, 0);
  455.   { Clear out the console input buffer }
  456.   while (keypressed) do
  457.     c := readkey;
  458. end; { procedure STOPSTAT }
  459.  
  460. function GRAFSTAT: boolean;
  461. { Every call to GRAFSTAT produces a new status dot, and also
  462.   checks the keyboard for a run abort.  GRAFSTAT returns TRUE if the
  463.   user wishes to abort the run (by pressing the 'A' key), or FALSE otherwise.
  464. }
  465. begin
  466.   Statpos := Statpos + 1;
  467.   if (Statpos > Gxmax-3) then
  468.     stopstat;
  469.   gplot (Statpos, Gymax-1, 1);
  470.   Grafstat := checkey;
  471. end; { procedure GRAFSTAT }
  472.  
  473.  
  474.  
  475. procedure SETGMODE;
  476.  
  477. { Set up graphics mode and draw the window }
  478. var
  479.   message: string;
  480.   temp : integer;
  481.  
  482. begin
  483.  
  484.   setgraphmode(grmode);
  485.   temp := (graphresult);
  486.   message := grapherrormsg(temp);
  487.   if message <> 'No error' then begin
  488.     restorecrtmode;
  489.     writeln;
  490.     writeln ('SETGraphMODE: BGI error: ',message);
  491.     writeln ('Error number: ',temp);
  492.     writeln ('GrSys is: ',Grsys);
  493.     writeln ('GrMode is: ',Grmode);
  494.     writeln ('SurfModl Halted');
  495.     halt;
  496.   end
  497.   else begin
  498.  
  499.     gdraw (Gxmin, Gymin, Gxmax, Gymin, 1);
  500.     gdraw (Gxmax, Gymin, Gxmax, Gymax, 1);
  501.     gdraw (Gxmax, Gymax, Gxmin, Gymax, 1);
  502.     gdraw (Gxmin, Gymax, Gxmin, Gymin, 1);
  503.  
  504.     stopstat;  { Initialize the graphics status line }
  505.  
  506.     setcolor(1);
  507.     if ngraphchar < length (flpurpose) then
  508.       flpurpose := copy (flpurpose,1,ngraphchar);
  509.  
  510.     outtextXY ((ngraphchar - length(flpurpose)) * 4,1 ,Flpurpose);
  511.   end; {else}
  512. end; { procedure SETGMODE }
  513.  
  514.  
  515.  
  516.  
  517. function savescrn (filename : string) : boolean;
  518. var
  519.   imagefile : file;
  520.   bitmap : pointer;
  521.   success : boolean;
  522.  
  523. begin
  524.   success := true;
  525.   getmem (bitmap,imagesize(0,0,GetMaxX, GetMaxY));
  526.  
  527.   if bitmap = nil then {error}
  528.     success := false
  529.   else begin
  530.     getimage (0,0,GetMaxX,GetMaxY,bitmap^);
  531.     putimage (0,0,bitmap^,NOTput);
  532.     if (graphresult = GrOK) AND (bitmap <> nil) then begin
  533.       {$I-}
  534.       assign (imagefile,filename);
  535.  
  536.       if ioresult <> 0 then
  537.         success := false;
  538.  
  539.       rewrite (imagefile,1);
  540.       if ioresult <> 0 then
  541.         success := false;
  542.  
  543.       blockwrite (imagefile,grsys,sizeof(grsys));
  544.       if ioresult <> 0 then
  545.         success := false;
  546.  
  547.       blockwrite (imagefile,grmode,sizeof(grmode));
  548.       if ioresult <> 0 then
  549.         success := false;
  550.  
  551.       blockwrite (imagefile,bitmap^,imagesize(0,0,GetMaxX, GetMaxY));
  552.       if ioresult <> 0 then
  553.         success := false;
  554.  
  555.       close (imagefile);
  556.       if ioresult <> 0 then
  557.         success := false;
  558.       {$I+}
  559.     end { Image successfuly read }
  560.     else { getimage not successful }
  561.       success := false;
  562.     putimage (0,0,bitmap^,NormalPut);
  563.     release (bitmap);
  564.   end; {memory available}
  565.  
  566.   savescrn := success;
  567. end; {savescrn}
  568.  
  569.  
  570.  
  571. function readscrn (filename : string; var grsys,grmode : integer;
  572.                               var bitmap : pointer) : boolean;
  573. var
  574.   imagefile : file;
  575.   success : boolean;
  576.  
  577. begin
  578.   success := true;
  579.   {$I-}
  580.   assign (imagefile,filename);
  581.  
  582.   if ioresult <> 0 then begin
  583.     success := false;
  584.     writeln ('File "',filename,'" not found');
  585.   end;
  586.  
  587.   reset (imagefile,1);
  588.   if ioresult <> 0 then begin
  589.     success := false;
  590.     writeln ('File "',filename,'" not found');
  591.   end;
  592.  
  593.   blockread (imagefile,grsys,sizeof(grsys));
  594.   if ioresult <> 0 then begin
  595.     success := false;
  596.     writeln ('Could not read grsys');
  597.   end;
  598.  
  599.   blockread (imagefile,grmode,sizeof(grmode));
  600.   if ioresult <> 0 then begin
  601.     success := false;
  602.     writeln ('Could not read grmode');
  603.   end;
  604.   {$I+}
  605.  
  606.  
  607.   if success then begin
  608.     getmem (bitmap,filesize(imagefile) - sizeof(grmode) - sizeof(grsys));
  609.     if bitmap = nil then begin
  610.         success := false;
  611.         writeln ('Could not allocate memory for bitmap');
  612.     end
  613.     else begin {memory successfully allocated}
  614.       {$I-}
  615.       blockread (imagefile,bitmap^,filesize(imagefile) - sizeof(grmode)
  616.                                    - sizeof(grsys));
  617.       if ioresult <> 0 then begin
  618.         success := false;
  619.         writeln ('Could not read image');
  620.       end;
  621.       {$I+}
  622.     end; {Memory allocated}
  623.   end; { Image successfuly read }
  624.  
  625.   {$I-}
  626.   close (imagefile);
  627.   {$I+}
  628.   if ioresult <> 0 then
  629.     success := false;
  630.  
  631.   readscrn := success;
  632. end; {readscrn}
  633.  
  634.  
  635. {************************************************************************}
  636. function get_env
  637.   (env_var: String)   { environment variable to look for                 }
  638.   : String;           { Value of environment variable                    }
  639. {                                                                        }
  640. {  Description:                                                          }
  641. {    Returns the value associated with the given environment variable    }
  642. {                                                                        }
  643. {************************************************************************}
  644. {                                                                        }
  645. {  Revision History:                                                     }
  646. {      "a" means Alpha version, Not Completed                            }
  647. {      "b" means Beta Test Version, Completed but in testing             }
  648. {      "c" means Completed Version.  This version is now frozen          }
  649. {                                                                        }
  650. {************************************************************************}
  651.  
  652. var
  653.   i,j: integer;
  654.   result: String;
  655.   found: boolean;
  656.   table_address: integer;
  657.  
  658. begin  { get_environment }
  659.   result := '';
  660.   i := 0;
  661.   table_address := memW[PrefixSeg:$002c];
  662.  
  663.   if length (env_var) <> 0 then begin
  664.     for j := 1 to length(env_var) do begin {convert to uppercase}
  665.       if env_var[j] in ['a'..'z'] then begin
  666.         env_var[j] := chr(ord(env_var[j])-32);
  667.       end; {then}
  668.     end; {for}
  669.  
  670.     repeat
  671.       result := '';
  672.       while (mem[table_address:i]) <> 0 do begin
  673.         result := result + chr(mem[table_address:i]);
  674.         i := i + 1;
  675.       end;
  676.  
  677.       if pos (env_var,result) = 1 then begin
  678.         found := true;
  679.         result := copy (result,length(env_var) + 2,length(result));
  680.       end
  681.       else
  682.         found := false;
  683.  
  684.       i := i + 1;
  685.     until found or (result = '');
  686.  
  687.   end; { Then find value }
  688.   get_env := result;
  689.  
  690. end;  {get_env}
  691.  
  692. {The following procedures link in the appropriate .OBJ files so the graphics }
  693. {drivers are always memory resident.  If you get an error message, then you  }
  694. {must copy the .BGI files into this directory, then run the BGI2OBJ batch    }
  695. {file.  It uses the turbo pascal 4.0 utility BINOBJ.                         }
  696.  
  697. {$IFDEF LINKATT}
  698. {$DEFINE LINKING}
  699. procedure ATTDriver; external;
  700. {$L ATT.OBJ }
  701. {$ENDIF}
  702.  
  703. {$IFDEF LINKCGA}
  704. {$DEFINE LINKING}
  705. procedure CgaDriver; external;
  706. {$L CGA.OBJ }
  707. {$ENDIF}
  708.  
  709. {$IFDEF LINKEGAVGA}
  710. {$DEFINE LINKING}
  711. procedure EgaVgaDriver; external;
  712. {$L EGAVGA.OBJ }
  713. {$ENDIF}
  714.  
  715. {$IFDEF LINKHERC}
  716. {$DEFINE LINKING}
  717. procedure HercDriver; external;
  718. {$L HERC.OBJ }
  719. {$ENDIF}
  720.  
  721. {$IFDEF LINKPC3270}
  722. {$DEFINE LINKING}
  723. procedure PC3270Driver; external;
  724. {$L PC3270.OBJ }
  725. {$ENDIF}
  726.  
  727. {$IFDEF LINKING}
  728. procedure Abort(Msg : string);
  729. begin
  730.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  731.   Halt(1);
  732. end;
  733. {$ENDIF}
  734.  
  735. BEGIN
  736.   driveron := false;
  737.   DoRandom := false;
  738.   RandShade := 1.0 / 16.0;
  739.   Mono := true;
  740.   grsys := -1;
  741.   grmode := -1;
  742.   viewchanged := true;
  743.  
  744.   {Get the directory the .BGI drivers are in}
  745.   BGIDIR := get_env('BGIDIR');
  746.  
  747. {$IFDEF LINKCGA}
  748.   if RegisterBGIdriver(@CGADriver) < 0 then
  749.     Abort('CGA');
  750. {$ENDIF}
  751.  
  752. {$IFDEF LINKEGAVGA}
  753.   if RegisterBGIdriver(@EGAVGADriver) < 0 then
  754.     Abort('EGA/VGA');
  755. {$ENDIF}
  756.  
  757. {$IFDEF LINKHERC}
  758.   if RegisterBGIdriver(@HercDriver) < 0 then
  759.     Abort('Herc');
  760. {$ENDIF}
  761.  
  762. {$IFDEF LINKATT}
  763.   if RegisterBGIdriver(@ATTDriver) < 0 then
  764.     Abort('AT&T');
  765. {$ENDIF}
  766.  
  767. {$IFDEF LINKPC2370}
  768.   if RegisterBGIdriver(@PC3270Driver) < 0 then
  769.     Abort('PC 3270');
  770. {$ENDIF}
  771.  
  772. {vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv}
  773. {If you get an error message, "Error 15: File not found (xxx.OBJ)" then you }
  774. {must copy the .BGI files into this directory, then run the BGI2OBJ batch   }
  775. {file.  It uses the turbo pascal 4.0 utility BINOBJ so it must be available }
  776. {^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}
  777. END.
  778.  
  779.